home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / FM-EXT20.ZIP / FM-EXT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-09-20  |  50KB  |  1,718 lines
  1. Program Fast_Module_Extractor;
  2. {$L FONT.OBJ}
  3.  
  4. Uses EnhDOS;
  5.  
  6. Const Buffer = 32767;  {Search buffer}
  7.  
  8. Type bytearray = Array [0..Buffer] Of char;
  9.      CharSet = Set OF Char;
  10.  
  11. Var
  12.   header                    :array[1..4] of char;
  13.   option                    :array[1..3] of string;
  14.   sample                    :bytearray;
  15.   doserror                  :integer;
  16.   attr, found, res,
  17.   patternsize, x, y         :word;
  18.   total, Position, l        :longint;
  19.   filenum, infile1, infile2,
  20.   min,s,hund,min_old,s_old,
  21.   hund_old                  :byte;
  22.   h,r,g,b                   :byte;
  23.   ID,tempstring,filename    :string;
  24.   pP,pFileName              :pchar;
  25.   Search                    :tsearchrec;
  26.   D                         :tdirstr;
  27.   N                         :tnamestr;
  28.   E                         :textstr;
  29.   ReadOnlyFile              :boolean;
  30.   TheTime                   :real;
  31.  
  32. Procedure Setfont;external; {Included with FONT.OBJ}
  33.  
  34. Function IsVGA: boolean;assembler;
  35.    asm
  36.         xor     bx,bx
  37.         mov     ax,01A00h
  38.         int     010h
  39.         mov     ax,1
  40.         cmp     bl,7
  41.         jnc     @@ok
  42.         cmp     bl,8
  43.         jnc     @@ok
  44.         xor     ax,ax
  45.     @@ok:
  46.   end;
  47.  
  48. function readkey:char;
  49. var t:char;
  50. begin
  51.   asm
  52.     xor ah,ah
  53.     int 16h
  54.     mov t,al
  55.   end;
  56.   readkey:=t;
  57. end;
  58.  
  59. procedure writeit(s:string;x,y:word;attr:byte);
  60. begin
  61. asm
  62.     mov ax,y
  63.     dec ax
  64.     mov dx,80
  65.     mul dx
  66.     dec ax
  67.     add ax,x
  68.     shl ax,1
  69.     mov di,ax {Calculation of beginning of string in videomemory}
  70.  
  71.     mov ax,0B800h
  72.     mov es,ax
  73.     xor ch,ch
  74.     mov cl,byte ptr s[0]
  75.     mov si,0
  76.     mov bh,attr
  77. @w: inc si
  78.     mov bl,byte ptr s[si]
  79.     mov es:[di],bx
  80.     inc di
  81.     inc di
  82.     loop @w
  83.   end;
  84. end;
  85.  
  86. Procedure cursoroff;assembler; {Hey, Borland! build this in a CRT or DOS unit}
  87.   asm
  88.     MOV   ax,$0100
  89.     MOV   cx,$2607
  90.     INT   $10
  91.   end;
  92.  
  93. Procedure cursoron;assembler; {Hey, Borland! build this in a CRT or DOS unit}
  94.   asm
  95.     MOV   ax,$0100
  96.     MOV   cx,$0506
  97.     INT   $10
  98.  end;
  99.  
  100. procedure Upper(var Str: String); {Thanks Bob Swart!!}
  101.   InLine(
  102.     $8C/$DA/               {      mov   DX,DS               }
  103.     $5E/                   {      pop   SI                  }
  104.     $1F/                   {      pop   DS                  }
  105.     $FC/                   {      cld                       }
  106.     $AC/                   {      lodsb                     }
  107.     $30/$E4/               {      xor   AH,AH               }
  108.     $89/$C1/               {      mov   CX,AX               }
  109.     $E3/$12/               {      jcxz  @30                 }
  110.     $BB/Ord('a')/Ord('z')/ {      mov   BX,'za'             }
  111.     $AC/                   { @15: lodsb                     }
  112.     $38/$D8/               {      cmp   AL,BL               }
  113.     $72/$08/               {      jb    @28                 }
  114.     $38/$F8/               {      cmp   AL,BH               }
  115.     $77/$04/               {      ja    @28                 }
  116.     $80/$6C/$FF/$20/       {      sub   BYTE PTR [SI-1],$20 }
  117.     $E2/$F1/               { @28: loop  @15                 }
  118.     $8E/$DA);              { @30: mov   DS,DX               }
  119.  
  120. function LeadingZero(w : Word) : String;
  121. var
  122.   s : String;
  123. begin
  124.   Str(w:0,s);
  125.   if Length(s) = 1 then s := '0' + s;
  126.   LeadingZero := s;
  127. end;
  128.  
  129. Function GetString(cx,cy,cc,pc : Byte; Default,Prompt : String; MaxLen : Integer;OKSet :charset):string;
  130.  
  131. { cx = Input Column }
  132. { cy = Input Row    }
  133. { cc = Input Color  }
  134. { pc = Prompt Color }
  135.  
  136. const
  137.   BS                 = #8;
  138.   CR                 = #13;
  139.   ESC                = #27;
  140.   iPutChar           = #249;
  141.   ConSet             : CharSet = [BS,CR,ESC];
  142. var
  143.   TStr:string;
  144.   x,i,tlen:byte;
  145.   Ch:char;
  146.  
  147. begin
  148.   TStr := '';
  149.   TLen := 0;
  150.   writeit(prompt,cx,cy,pc);
  151.   x := cx + ord(Prompt[0]);
  152.   For i := x to (x + Maxlen - 1) do writeit(iputChar,i,cy,cc);
  153.   if default<>'' then writeit(default,x,cy,cc);
  154.   OKSet := OKSet + ConSet;
  155.   cursoron;
  156.   repeat
  157.     asm
  158.       mov ah,2
  159.       mov dh,cy
  160.       dec dh
  161.       mov dl,x
  162.       dec dl
  163.       mov bh,0
  164.       int 10h
  165.     end;
  166.     repeat
  167.        ch:=readkey
  168.     until ch in OKSet;
  169.     if tlen=0 then for i := x to (x + ord(default[0])) do writeit(iputChar,i,cy,cc);
  170.     case ch of
  171.     BS: begin
  172.           if TLen > 0 then begin
  173.                              dec(TLen);
  174.                              dec(x);
  175.                              WriteIt(iPutChar,x,cy,cc);
  176.                            end;
  177.         end;
  178.     else if (Ch<>CR) and (Ch<> ESC) and (TLen < MaxLen) then
  179.          begin
  180.            WriteIt(Ch,x,cy,cc);
  181.            inc(TLen);
  182.            TStr[TLen] := Ch;
  183.            inc(X);
  184.          end;
  185.     end;
  186.   until (Ch = CR) or (Ch = ESC);
  187.   If Tlen > 0 Then Begin
  188.                      TStr[0] := chr(Tlen);
  189.                      Getstring := TStr
  190.                    End
  191.   Else Getstring := Default;
  192.   cursoroff;
  193. end;
  194.  
  195.  
  196. Procedure drawline(Line: Integer;color:byte); {Draws a line...}
  197. Var i: Integer;
  198. Begin
  199.   writeit('■',1,line,color);
  200.   For i := 2 To 79 Do writeit('─',i,line,color);
  201.   writeit('■',80,line,color);
  202. End;
  203.  
  204. Procedure clearline;  {Go to statusline and set color}
  205. var i:byte;
  206. Begin
  207.   for i:=1 to 80 do writeit(' ',i,14,112);
  208. End;
  209.  
  210. procedure drawbar(m,line:byte);
  211.  
  212. begin
  213.   For Y := 2 To (m+1) Do
  214.   Begin
  215.     writeit('█',2+(Y shr 2),line,126);
  216.     str(m,tempstring);
  217.     writeit (' '+tempstring+'%  ',27,line,126);
  218.   End;
  219. End;
  220.  
  221. procedure read68000_32bit(var b:longint);
  222. var temp: longint;
  223.     hoog:byte;
  224. begin
  225.          b:=0;
  226.          h_Read(infile2,hoog,sizeof(hoog));
  227.          temp:=hoog;
  228.          b:=temp shl 24;
  229.          h_read(infile2,hoog,sizeof(hoog));
  230.          temp:=hoog;
  231.          b:=b+(temp shl 16);
  232.          h_read(infile2,hoog,sizeof(hoog));
  233.          temp:=hoog;
  234.          b:=b+(temp shl 8);
  235.          h_read(infile2,hoog,sizeof(hoog));
  236.          temp:=hoog;
  237.          b:=b+temp;
  238. end;
  239.  
  240. procedure smoothexit;
  241.  
  242. var i,vel:word;
  243.  
  244. begin
  245.   writeit('Thanks for using...',30,35,3);
  246.   i:=0;
  247.   vel:=0;
  248.   REPEAT {Credits to VangeliSTeam for this code!}
  249.       WHILE (Port[$3DA] AND 8) =  8 DO;
  250.       asm cli end;
  251.       Port[$3d4] := $c; Port[$3d5] := HI((i DIV 16)*80);
  252.       Port[$3d4] := $d; Port[$3d5] := LO((i DIV 16)*80);
  253.       WHILE (Port[$3DA] AND 8) <> 8 DO;
  254.       Port[$3d4] := 8; Port[$3d5] := (Port[$3d5] AND $E0) OR (i AND $0F);
  255.       asm sti end;
  256.       inc (vel); {more increments...more speed}
  257.       inc (vel);
  258.       inc (vel);
  259.       inc (vel);
  260.       i := i + (vel DIV 16);
  261.   UNTIL i >= 25*16;
  262.   cursoron;
  263.   asm
  264.    mov ax,3h
  265.    int 10h
  266.   end;
  267.   Halt;
  268. end;
  269.  
  270. Procedure waitforkey; {wait until a key is pressed}
  271. Begin
  272.   writeit('■',2,18,252);
  273.   if Readkey=#27 then SmoothExit
  274.                  else clearline;
  275.   writeit(' ',2,18,112)
  276. End;
  277.  
  278. Function SaveIt(s:string;position:longint):boolean;
  279.  
  280. begin
  281.   clearline;
  282.   str(position,tempstring);
  283.   writeit (s+' found at position '+tempstring+'. Save it (y/N)?',2,14,121);
  284.   Case ReadKey of
  285.   #89,#121: SaveIt:=True;
  286.       #27: SmoothExit;
  287.   else begin
  288.          SaveIt:=False;
  289.          writeit ('                                                   ',30,9,113);
  290.        end;
  291.   End;
  292. end;
  293.  
  294. Procedure Written(s:string;length:longint);
  295. begin
  296.   clearline;
  297.   str(length,tempstring);
  298.   writeit(s+' written: '+tempstring+' bytes.',2,14,121);
  299.   waitforkey;
  300. end;
  301.  
  302.  
  303. Procedure writefile (ext:string;filebegin,filelength: LongInt); {Copies the mod out of the demo}
  304. Var filelengthstr,fileout:string;
  305.   outfile: byte;
  306.   err:word;
  307.   pfileout:pchar;
  308.   writebuffer: Array [1..4096] Of Byte;
  309.   numread,buffers: Integer;
  310.   temp:char;
  311.   i: LongInt;
  312.   continue:boolean;
  313.   OldSearchRec:TSearchRec;
  314.  
  315. Begin
  316.   GetMem(pFileOut,80);
  317.   OldSearchRec:=Search;
  318.   gettime(h,min,s,hund);
  319.   repeat
  320.     continue:=true;
  321.     clearline;
  322.     cursoron;
  323.     inc(filenum);
  324.     str(filenum,tempstring);
  325.     tempstring:=tempstring+'.'+ext;
  326.     fileout:=GetString(2,14,112,112,tempstring,'Enter filename: ',62,['!'..'~']);
  327.     pfileout:=pas2pchar(fileout);
  328.     if existsfile(pfileout) then
  329.       begin
  330.         cursoroff;
  331.         writeit('File already exists. Overwrite it ['+fileout+'] (Y/n)',2,14,112);
  332.         temp:=readkey;
  333.         if (temp=#78) or (temp=#110) then continue:=false
  334.         else continue:=true;
  335.         clearline;
  336.         DeleteFile(pfileout);
  337.       end;
  338.   until continue;
  339.   cursoroff;
  340.   err:=h_seek(infile2,filebegin,0);
  341.   outfile:=h_Createfile(pfileout);
  342.   for i:=2 to 26 do writeit('▒',i,9,112);
  343.   buffers:=(filelength div sizeof(writebuffer));
  344.   str(filelength:7,filelengthstr);
  345.   for i:=1 to buffers do
  346.     begin
  347.       h_read(infile2,writebuffer,sizeof(writebuffer));
  348.       h_write(outfile,writebuffer,sizeof(writebuffer));
  349.       str(4096*i:7,tempstring);
  350.       writeit(' Processing: '+tempstring+' bytes of '+filelengthstr+' bytes.',1,7,121);
  351.       drawbar((100*4096*i) div filelength,9);
  352.     end;
  353.   h_read(infile2,writebuffer,filelength-(4096*buffers));
  354.   h_write(outfile,writebuffer,filelength-(4096*buffers));
  355.   writeit(' Processing: '+filelengthstr+' bytes of '+filelengthstr+' bytes.',1,7,121);
  356.   drawbar(100,9);
  357.   h_closefile(outfile);
  358.   settime(h,min,s,hund);
  359.   Search:=OldSearchRec;
  360. End;
  361.  
  362. Procedure DisplayHelp;
  363. var i,o:byte;
  364.  
  365. begin;
  366.     for x:=1 to 80 do writeit(' ',x,1,79);
  367.     writeit (' Fast Module Extractor 2.0 ',1,1,79);
  368.     for x:=2 to 25 do for y:=1 to 80 do writeit(' ',y,x,112);
  369.     writeit (' Usage: FM-EXT filename <options>',1,3,126);
  370.     writeit (' Extracts: FastTracker 1.x and 2.0x modules',1,6,121);
  371.     writeit ('           ScreamTracker 2.x and 3.x modules',1,7,121);
  372.     writeit ('           MultiTracker and 669 modules',1,8,121);
  373.     writeit ('           Farandole and UltraTracker modules',1,9,121);
  374.     writeit ('           DigiTrakker, PolyTracker and Delusion modules',1,10,121);
  375.     writeit ('           AMF, MIDI and Wave-files',1,11,121);
  376.     writeit ('           LBM, BMP-pictures and FLI, FLC-animations',1,12,121);
  377.     writeit (' Detects:  GIF, JPG',1,13,121);
  378.     writeit (' Wildcards allowed!',1,15,124);
  379.     writeit ('  Options: X                Turn on BMP, 669, FLI, FLC searching',1,17,120);
  380.     writeit ('           !<ABCD> <offset> Custom header search (1..255 chars!)',1,18,120);
  381.     writeit ('           #<begin> <end>   Partial copy mode',1,19,120);
  382.     writeit (' See DOCs for details',1,21,127);
  383.     drawline(23,125);
  384.     drawline(25,117);
  385.     tempstring:=GetString(2,24,7,7,'','>FM-EXT ',70,[' '..#255]);
  386.     pp:=Pas2PChar(tempstring);
  387.     i:=0;
  388.     for x:=1 to 3 do
  389.     begin
  390.       if pp[i]=' 'then
  391.          repeat inc(i) until pp[i]<>' ';
  392.       o:=1;
  393.       repeat
  394.         option[x,o]:=pp[i];
  395.         inc(i);
  396.         inc(o);
  397.       until (pp[i]=' ') or (pp[i]=#0);
  398.       option[x,0]:=chr(o-1);
  399.     end;
  400. End;
  401.  
  402. Procedure write669; {Extracts ComposD 669}
  403. Var title669: Array [1..108] Of Char;
  404.   nos, nop: Byte;
  405.   sample: Word;
  406.   begin669,temp,Length669, i: LongInt;
  407.  
  408. Begin
  409.   gettime(h,min,s,hund);
  410.   Position := (l - res) + X; {Where is the start}
  411.   Length669 := 0;
  412.   If (search.size - position) > 110 Then
  413.     begin
  414.       Begin669 := Position - 1;  {Calculate 669 beginning}
  415.       h_Seek (infile2, Begin669 + 2,0);
  416.       h_Read (infile2, title669, SizeOf (title669) );
  417.       h_Seek(infile2, Begin669 + 110,0);
  418.       h_Read (infile2, nos,SizeOf (nos) ); {Read # of samples}
  419.       h_Read (infile2, nop,SizeOf (nop) ); {Read # of patterns}
  420.       h_Seek (infile2, begin669 + 510,0);
  421.       For i := 1 To nos Do
  422.         Begin              {Read NOS times the sample lengths}
  423.           h_Read (infile2, sample, SizeOf (sample) );
  424.           h_Seek (infile2, (begin669 + 510) + (i * $19),0 );
  425.           Length669 := Length669 + sample;
  426.         End;
  427.       temp:=nop;
  428.       Length669 := Length669 + (temp * 1536);
  429.       temp:=nos;
  430.       Length669 := Length669 + (temp * $19) +$1F1; {Calculate total length}
  431.       if (length669 > 0) and ((Begin669 +length669) <= search.size) Then
  432.       begin
  433.         writeit ('Title: ',33,9,113);
  434.         For i := 1 To 36 Do writeit (title669 [i],39+i,9,113);
  435.         For i := 37 To 72 Do writeit (title669 [i],39+(i-36),10,113);
  436.         For i := 73 To 108 Do writeit (title669 [i],39+(i-72),11,113);
  437.         ID:='669 File';
  438.         if SaveIt(ID,begin669) then
  439.           Begin
  440.             writefile ('669',begin669,Length669); {writeit it!}
  441.             written(ID,length669);
  442.  
  443.           end;
  444.         writeit('                                             ',39,10,113);
  445.         writeit('                                             ',39,11,113);
  446.         clearline;
  447.       end;
  448.     end;
  449.   settime(h,min,s,hund);
  450. End;
  451.  
  452. Procedure writeS3M; {Extracts ScreamTracker 3.0 files}
  453. Var titleS3M: Array [1..28] Of Char;
  454.   noo, nos, nop: Word;
  455.   sample: Word;
  456.   memseg: Word;
  457.   i,begins3m, lengths3m, memsegold, Length: LongInt;
  458.   t: Byte;
  459.  
  460. Begin
  461.   gettime(h,min,s,hund);
  462.   Position := (l - res) + X;
  463.   lengths3m := 0;
  464.   memsegold := 0;
  465.   Begins3m := Position - 45;
  466.   h_seek (infile2, Begins3m,0);
  467.   h_read (infile2, titleS3M, SizeOf (titleS3M) ); {Read title}
  468.   h_seek (infile2, Begins3m + 32,0);
  469.   h_read (infile2, noo, SizeOf (noo) ); {Read # of orders}
  470.   h_read (infile2, nos, SizeOf (nop) ); {Read # of patterns}
  471.   h_read (infile2, nop, SizeOf (nos) ); {Read # of samples}
  472.   h_seek (infile2, begins3m + 96 + noo,0);
  473.   if nos <> 0 then For i := 0 To nos - 1 Do                 {Read NOS times the pointers to all samples}
  474.     Begin
  475.       h_seek (infile2, begins3m + 96 + noo + i + i,0);
  476.       h_read (infile2, sample, SizeOf (sample) );
  477.       h_seek (infile2, 14 + begins3m + (sample * 16) ,0);
  478.       h_read (infile2, memseg, SizeOf (memseg) );
  479.       If memseg > memsegold Then
  480.         Begin
  481.           memsegold := memseg;
  482.           h_read (infile2, Length, SizeOf (Length) ); {Read last sample length}
  483.           lengths3m := (memsegold * 16) + Length;        {Add last sample length and last filepointer}
  484.         End;
  485.       End;
  486.   if (lengths3m > 0) and ((Begins3m +lengths3m) <= search.size) Then
  487.   begin
  488.     ID:='ScreamTracker 3.0';
  489.     writeit ('Title: '+ titleS3M,34,9,113);
  490.     if SaveIt(ID,position) then
  491.       Begin
  492.         writefile ('S3M',begins3m,lengths3m);
  493.         written(ID,lengths3m);
  494.       end;
  495.     clearline;
  496.   end;
  497.   settime(h,min,s,hund);
  498. End;
  499.  
  500. Procedure writeMTM; {Extracts MultiTracker 1.x files}
  501. Var titleMTM: Array [1..20] Of Char;
  502.   lps, nos: Byte;
  503.   loc, trks: Word;
  504.   i,beginmtm, lengthmtm, sample: LongInt;
  505.  
  506. Begin
  507.   gettime(h,min,s,hund);
  508.   Position := (l - res) + X;
  509.   lengthmtm := 0;
  510.   If (search.size - position) > 100 Then
  511.     begin
  512.       Beginmtm := Position - 1;
  513.       h_seek (infile2, Beginmtm + 4,0);
  514.       h_read (infile2, titleMTM, SizeOf (titleMTM) ); {Read title}
  515.       h_seek (infile2, Beginmtm + 24,0);
  516.       h_read (infile2, trks, SizeOf (trks) ); {Read # of tracks}
  517.       h_read (infile2, lps, SizeOf (lps) );   {Read # of ?}
  518.       h_seek (infile2, beginmtm + 28,0);
  519.       h_read (infile2, loc, SizeOf (loc) );
  520.       h_read (infile2, nos, SizeOf (nos) );   {Read # of samples}
  521.       lengthMTM := (194 + (nos * 37) + (trks * 192) + ( (lps + 1) * 32 * 2) + loc);
  522.       h_seek (infile2, beginMTM + 88,0);
  523.       For i := 1 To nos Do
  524.          begin
  525.            h_read (infile2, sample, SizeOf (sample) );
  526.            h_seek (infile2, (beginmtm + 88) + (i * 37) ,0);
  527.            lengthMTM := lengthMTM + sample;
  528.          end;
  529.       if (lengthmtm > 0) and ((Beginmtm + lengthmtm) <= search.size) Then
  530.         begin
  531.           writeit('Title: '+titleMTM,34,9,113);
  532.           ID:='MultiTracker Module';
  533.           if SaveIt(ID,beginmtm) then
  534.             begin
  535.               writefile ('MTM',beginmtm,lengthmtm);
  536.               written(ID,lengthmtm);
  537.             end;
  538.           clearline;
  539.         end;
  540.     end;
  541.   settime(h,min,s,hund);
  542. End;
  543.  
  544. Procedure WriteMOD;{(patternsize: word); {Flexible MOD file extractor}
  545. Var i, modbegin,modlength: LongInt;
  546.     title: Array [1..20] Of Char;
  547.     Pattern: Array [1..128] Of Byte;
  548.     number,laag, hoog: Byte;
  549.  
  550. Begin
  551.   gettime(h,min,s,hund);
  552.   Position := (l - res) + X;
  553.   number:=0;
  554.   modlength := 0;
  555.   ModBegin := Position - 1081;
  556.   if ModBegin >= 0 then
  557.     begin
  558.       h_seek (infile2, ModBegin,0);
  559.       h_read (infile2, title, SizeOf (title) ); {Reads title}
  560.       h_seek (infile2, ModBegin + 42,0);
  561.       For i := 1 To 31 Do  {Reads sample sizes}
  562.          Begin
  563.            h_read (infile2, hoog, SizeOf (hoog) );
  564.            h_read (infile2, laag, SizeOf (laag) );
  565.            h_seek (infile2, ModBegin + 42 + (i * 30) ,0);
  566.            modlength := modlength + ( (hoog * 256) + laag);
  567.          End;
  568.       modlength := modlength * 2;
  569.       h_seek (infile2, Modbegin + 952,0);
  570.       h_read (infile2, Pattern, 128); {Reads pattern order, highest number -> number of patterns}
  571.       For i := 1 To 128 Do If number < Pattern [i] Then number := Pattern [i];
  572.       i:=patternsize; {Must convert patternsize to longint...causes otherwise an FP error}
  573.       modlength := modlength + ( (number + 1)* i) + 1084;
  574.       h_seek (infile2, ModBegin,0);
  575.       if (modlength > 0) and ((ModBegin +Modlength) <= search.size) Then
  576.         begin
  577.           writeit('Title: '+ title,34,9,113);
  578.           str(patternsize div 256,tempstring);
  579.           ID:=tempstring+' Channel MOD File';
  580.           if SaveIt(ID,position) then
  581.             begin
  582.               writefile('MOD',modbegin,modlength);
  583.               written(ID,modlength);
  584.             End;
  585.           clearline;
  586.        end;
  587.     end;
  588.   settime(h,min,s,hund);
  589. End;
  590.  
  591. Procedure writeSTM; {Extracts ScreamTracker 2.x / BMOD2STM / SWavePro files}
  592.  
  593. Var i, beginstm,stmlength: LongInt;
  594.   title: Array [1..20] Of Char;
  595.   los: Word;
  596.   nop: Byte;
  597.  
  598. Begin
  599.   gettime(h,min,s,hund);
  600.   Position := (l - res) + X;
  601.   stmlength := 0;
  602.   Beginstm := Position - 25;
  603.   h_seek (infile2, Beginstm,0);
  604.   h_read (infile2, title, SizeOf (title) );
  605.   h_seek (infile2, Beginstm + 33,0);
  606.   h_read (infile2, nop, SizeOf (nop) ); {Read # of patterns}
  607.   h_seek (infile2, Beginstm + 64,0);
  608.   stmlength := nop;
  609.   stmlength := stmlength * 1024;
  610.   For i := 1 To 31 Do
  611.     Begin
  612.       h_read (infile2, los, SizeOf (los) );
  613.       h_seek (infile2, Beginstm + 64 + (i * 32) ,0);
  614.       If (los mod 16) <> 0  Then los := 16*(los Div 16);
  615.       stmlength := stmlength + los;
  616.     End;
  617.   stmlength := stmlength + (31 * 32) + 48 + 128;
  618.   if (stmlength > 0) and ((Beginstm +stmlength) <= search.size) Then
  619.    begin
  620.      writeit ('Title: '+ title,34,9,113);
  621.      ID:='ScreamTracker 2.x';
  622.      if SaveIt(ID,beginstm) then
  623.         Begin
  624.           writefile ('STM',beginstm,stmlength);
  625.           written(ID,stmlength);
  626.         end;
  627.      clearline;
  628.    end;
  629.   settime(h,min,s,hund);
  630. End;
  631.  
  632. Procedure writeAMF; {Extracts DMP format .AMF, copies from header to end of file}
  633.                     {so the length isn't always accurate}
  634. Var amfbegin,amflength: LongInt;
  635.   title: Array [1..30] Of Char;
  636. Begin
  637.   gettime(h,min,s,hund);
  638.   Position := (l - res) + X;
  639.   amflength := 0;
  640.   amfBegin := Position - 1;
  641.   h_seek (infile2, amfBegin + 4,0);
  642.   h_read (infile2, title, SizeOf (title) );
  643.   writeit ('Title: '+ title,34,9,113);
  644.   amflength := search.size - amfbegin;
  645.   ID:='AMF File';
  646.   if SaveIt(ID,amfbegin) then
  647.        Begin
  648.          writefile ('AMF',amfbegin,amflength);
  649.          written(ID,amflength);
  650.        End;
  651.   clearline;
  652.   settime(h,min,s,hund);
  653. End;
  654.  
  655. Procedure writeDMF; {Delusion Music Format}
  656. var dmfbegin,dmflength: LongInt;
  657.     title: Array [1..30] Of Char;
  658. Begin
  659.   gettime(h,min,s,hund);
  660.   Position := (l - res) + X;
  661.   dmflength := 0;
  662.   dmfBegin := Position - 1;
  663.   h_seek (infile2, dmfBegin + 13,0);
  664.   h_read (infile2, title, SizeOf (title) );
  665.   writeit ('Title: '+ title,34,9,113);
  666.   dmflength := search.size - dmfbegin;
  667.   ID:='Delusion Music File';
  668.   if SaveIt(ID,dmfbegin) then
  669.        Begin
  670.          writefile ('DMF',dmfbegin,dmflength);
  671.          written(ID,dmflength);
  672.        End;
  673.   clearline;
  674.   settime(h,min,s,hund);
  675. End;
  676.  
  677. Procedure writeMDL;
  678. Var mdlbegin,mdllength,blocklen: LongInt;
  679.                           title: array[1..32] of Char;
  680.                         blockID: array[1..2] of char;
  681.                               i: byte;
  682. begin
  683.   gettime(h,min,s,hund);
  684.   Position := (l - res) + X;
  685.   mdllength := 5;
  686.   mdlBegin := Position - 1;
  687.   h_seek (infile2, mdlBegin + 11,0);
  688.   h_read (infile2, title, sizeof(title));
  689.   h_seek (infile2, mdlBegin + 5,0);
  690.   h_read (infile2, blockID, 2);
  691.   i:=1;
  692.   repeat
  693.     h_read(infile2, blocklen, 4);
  694.     MDLlength:=MDLLength+blocklen+6;
  695.     h_seek(infile2, MDLbegin + MDLlength,0);
  696.     h_read(infile2, blockID,2);
  697.     inc(i);
  698.   until (blockID='SA') or (i > 15);
  699.   h_read (infile2, blocklen, 4);
  700.   MDLlength:=MDLLength+blocklen+6;
  701.   if (mdllength > 0) and ((MdlBegin +Mdllength) <= search.size) Then
  702.     begin
  703.       writeit ('Title: '+ title,34,9,113);
  704.       ID:='DigiTrakker MDL File';
  705.       if SaveIt(ID,mdlbegin) then
  706.         begin
  707.           writefile ('MDL',mdlbegin,mdllength);
  708.           written(ID,mdllength);
  709.         end;
  710.       clearline;
  711.     end;
  712.   settime(h,min,s,hund);
  713. end;
  714.  
  715. Procedure writeXM; {Write's FastTracker 2.0 XM (Extended Module) files}
  716.  
  717. Var XMbegin,XMlength: LongInt;
  718.     j,HeaderSize,PatternSize,InstrSize,SampHeadSize,SampleLength,TotalSample:Longint;
  719.     PackPattSize:word;
  720.     ii,i,NOP,NOI,NOS:word;
  721.     check: Array [1..17] Of Char;
  722.     title: Array [1..20] of Char;
  723.  
  724. Begin
  725.   gettime(h,min,s,hund);
  726.   Position := (l - res) + X;
  727.   XMlength := 0;
  728.   XMBegin := Position - 1;
  729.   h_seek(infile2, XMBegin,0);
  730.   h_read(infile2, check, sizeof(check));
  731.   if check='Extended Module: ' then
  732.     begin
  733.       h_seek(infile2, XMBegin+17,0);
  734.       h_read(infile2, title, sizeof(title));
  735.       h_seek(infile2, XMBegin+60,0);
  736.       h_read(infile2, headersize,4);
  737.       h_seek(infile2, XMBegin+70,0);
  738.       h_read(infile2, NOP,2);
  739.       h_seek(infile2, XMBegin+72,0);
  740.       h_read(infile2, NOI,2);
  741.       if (NOI<=128) and (NOP<=256) then
  742.         begin
  743.           patternsize:=0;
  744.           PackPAttSize:=0;
  745.           j:=0;
  746.           for i:= 1 to NOP do
  747.             begin
  748.               h_seek(infile2, XMBegin+60+headersize+j,0);
  749.               h_read(infile2, patternsize,4);
  750.               h_seek(infile2, XMBegin+60+headersize+j+7,0);
  751.               h_read(infile2, PackPattSize,2);
  752.               j:=j+packpattsize+patternsize;
  753.             end;
  754.           XMLength:=HeaderSize+60+j;
  755.           j:=0;
  756.           for i:= 1 to NOI do
  757.             begin
  758.               h_seek(infile2,XMBegin+XMLength+j,0);
  759.               h_read(infile2, Instrsize,4);
  760.               h_seek(infile2,XMbegin+XMLength+j+27,0);
  761.               h_read(infile2, NOS,2);
  762.               if NOS<>0 then
  763.                 begin
  764.                   h_seek(infile2,XMBegin+XMLength+j+29,0);
  765.                   h_read(infile2,SampHeadSize,4);
  766.                   j:=j+InstrSize;
  767.                   TotalSample:=0;
  768.                   for ii:=1 to NOS do
  769.                     begin
  770.                       h_seek(infile2,XMBegin+XMLength+j,0);
  771.                       h_read(infile2,SampleLength,4);
  772.                       j:=j+SampHeadSize;
  773.                       TotalSample:=TotalSample+Samplelength;
  774.                     end;
  775.                   j:=j+TotalSample;
  776.                 end
  777.               else
  778.               j:=j+InstrSize;
  779.             end;
  780.           XMLength:=XMLength+j;
  781.           if (xmlength > 0) and ((xmBegin + xmlength) <= search.size) Then
  782.             begin
  783.               writeit ('Title: '+ title,34,9,113);
  784.               ID:='FastTracker 2.0 File';
  785.               if SaveIt(ID,xmbegin) then
  786.                 begin
  787.                   writefile('XM',xmbegin,xmlength);
  788.                   written(ID,xmlength);
  789.                 end;
  790.               clearline;
  791.             end;
  792.         end;
  793.     end;
  794.    settime(h,min,s,hund);
  795. End;
  796.  
  797.  
  798. Procedure writeFAR; {Extracts Farandole composer files}
  799.                     {Reads from header to end of file, so search.name isn't always OK}
  800. Var i, farbegin,farlength: LongInt;
  801.   title: Array [1..40] Of Char;
  802.   headerlength,songtextlength:word;
  803.   nop:byte;
  804. Begin
  805.   gettime(h,min,s,hund);
  806.   Position := (l - res) + X;
  807.   farlength := 0;
  808.   farBegin := Position - 1;
  809.   h_seek (infile2, farBegin + 4,0);
  810.   h_read (infile2, title, SizeOf (title) );
  811.   writeit ('Title: '+ title,34,9,113);
  812.   farlength := search.size - farbegin;
  813.   ID:='Farandole File';
  814.   If SaveIt(ID,farbegin) then
  815.   Begin
  816.          writefile ('FAR',farbegin,farlength);
  817.          written(ID,farlength);
  818.   End;
  819.   clearline;
  820.   settime(h,min,s,hund);
  821. End;
  822.  
  823. Procedure writeULT; {Extracts UltraTracker format, copies from header to end of file}
  824.                     {so the length isn't always accurate}
  825. Var i, ultbegin,ultlength: LongInt;
  826.   title: Array [1..32] Of Char;
  827. Begin
  828.   gettime(h,min,s,hund);
  829.   Position := (l - res) + X;
  830.   ultlength := 0;
  831.   ultBegin := Position - 1;
  832.   h_seek (infile2, ultBegin + 15,0);
  833.   h_read (infile2, title, SizeOf (title) );
  834.   writeit ('Title: '+ title,34,9,113);
  835.   ID:='UltraTracker File';
  836.   ultlength := search.size - ultbegin;
  837.   if SaveIt(ID,ultbegin) then
  838.   Begin
  839.          writefile ('ULT',ultbegin,ultlength);
  840.          written(ID,ultlength);
  841.   End;
  842.   clearline;
  843.   settime(h,min,s,hund);
  844. End;
  845.  
  846. Procedure writePTM; {Extracts PolyTracker format, copies from header to end of file}
  847.                     {so the length isn't always accurate...mostly NOT}
  848. Var titlePTM: Array [1..28] Of Char;
  849.   noo, nos, nop: Word;
  850.   sample, slength: LongInt;
  851.   i,beginPTM, lengthPTM, memsegold, Length: LongInt;
  852.   t: Byte;
  853.  
  854. Begin
  855.   gettime(h,min,s,hund);
  856.   Position := (l - res) + X;
  857.   lengthPTM := 0;
  858.   memsegold := 0;
  859.   BeginPTM := Position - 45;
  860.   h_seek (infile2, BeginPTM,0);
  861.   h_read (infile2, titlePTM, SizeOf (titlePTM) ); {Read title}
  862.   h_seek (infile2, BeginPTM + 32 + 2,0);
  863.   h_read (infile2, nos, SizeOf(nos));
  864.   h_seek (infile2, BeginPTM + 608 + 18,0);
  865.   if nos <> 0 then
  866.   begin
  867.       h_seek (infile2, beginPTM+608 + 18 + ((nos-1)*80),0);
  868.       h_read (infile2, sample, SizeOf(sample));
  869.       h_read (infile2, slength, SizeOf(slength));
  870.       lengthPTM:=slength+sample;
  871.   end;
  872.   if (lengthPTM > 0) and ((BeginPTM +lengthPTM) <= search.size) Then
  873.   begin
  874.     ID:='PolyTracker File';
  875.     writeit ('Title: '+ titlePTM,34,9,113);
  876.     if SaveIt(ID,beginPTM) then
  877.       Begin
  878.         writefile ('PTM',beginPTM,LengthPTM);
  879.         written(ID,lengthPTM);
  880.       end;
  881.     clearline;
  882.   end;
  883.  settime(h,min,s,hund);
  884. End;
  885.  
  886. Procedure writePAC; {Extracts SB Studio PAC file}
  887. Var i, pacbegin,paclength: LongInt;
  888.  
  889. Begin
  890.   gettime(h,min,s,hund);
  891.   Position := (l - res) + X;
  892.   paclength := 0;
  893.   pacBegin := Position - 1;
  894.   h_seek (infile2, pacBegin + 4,0);
  895.   h_read(infile2, paclength,4);
  896.   paclength:=paclength+8;
  897.   if (paclength > 0) and ((pacBegin + paclength) <= search.size) Then
  898.     begin
  899.       ID:='SB Studio .PAC File';
  900.       if SaveIt(ID,pacbegin) then
  901.         Begin
  902.           writefile ('LBM',pacbegin,paclength);
  903.           written(ID,paclength);
  904.         End;
  905.       clearline;
  906.     end;
  907.   settime(h,min,s,hund);
  908. End;
  909.  
  910. procedure writeMIDI;
  911. var i,hoog,laag,noft:byte;
  912.     midibegin,tracklength,midilength:longint;
  913. begin
  914.   gettime(h,min,s,hund);
  915.   Position := (l - res) + X;
  916.   midilength := 0;
  917.   tracklength:=0;
  918.   midiBegin := Position - 1;
  919.   h_seek(infile2,midibegin+10,0);
  920.   h_read(infile2,hoog,sizeof(hoog));
  921.   h_read(infile2,laag,sizeof(laag));
  922.   noft:=(hoog*256)+laag;  {Number of tracks}
  923.   h_seek(infile2,midibegin+14,0);
  924.   for i:=1 to noft do
  925.     begin
  926.       h_seek(infile2,h_filepos(infile2)+4+tracklength,0);
  927.       read68000_32bit(tracklength);
  928.       midilength:=midilength+tracklength;
  929.     end;
  930.   midilength:=midilength+14+(noft*8);
  931.   if (midilength > 0) and ((midiBegin+midilength) <= search.size) Then
  932.   begin
  933.     ID:='MIDI File';
  934.     if SaveIt(ID,midibegin) then
  935.       begin
  936.         writefile('MID',midibegin,midilength);
  937.         written(ID,midilength);
  938.       end;
  939.     clearline;
  940.   end;
  941.   settime(h,min,s,hund);
  942. end;
  943.  
  944. Procedure writeLBM; {Extracts LBM graphics file}
  945. Var i, lbmbegin,LBMlength: LongInt;
  946.     header:array[1..4] of char;
  947.     t: Byte;
  948. Begin
  949.   gettime(h,min,s,hund);
  950.   Position := (l - res) + X;
  951.   lbmlength := 0;
  952.   lbmBegin := Position - 1;
  953.   h_seek (infile2, lbmBegin + 4,0);
  954.   read68000_32bit(lbmlength);
  955.   h_seek(infile2, lbmBegin + 12,0);
  956.   h_read(infile2, header,4);
  957.   lbmlength:=lbmlength+8;
  958.   if (header='BMHD') and (lbmlength > 0) and ((lbmBegin +lbmlength) <= search.size) Then
  959.     begin
  960.       ID:='LBM Picture';
  961.       if SaveIt(ID,lbmbegin) then
  962.         Begin
  963.           writefile ('LBM',lbmbegin,lbmlength);
  964.           written(ID,lbmlength);
  965.         End;
  966.       clearline;
  967.     end;
  968.   settime(h,min,s,hund);
  969. End;
  970.  
  971. Procedure writeBMP; {Extracts BMP files}
  972. Var bmpbegin,BMPlength: LongInt;
  973. Begin
  974.   gettime(h,min,s,hund);
  975.   Position := (l - res) + X;
  976.   bmplength := 0;
  977.   bmpBegin := Position - 1;
  978.   h_seek (infile2, bmpBegin + 2,0);
  979.   if (search.size-bmpbegin) > 4 then h_read (infile2, bmplength, SizeOf (bmplength) ); {Reads length of BMP}
  980.   if (bmplength > 0) and ((bmpBegin +bmplength) <= search.size) Then
  981.     begin
  982.       ID:='BMP Picture';
  983.       If SaveIt(ID,bmpbegin) then
  984.         Begin
  985.           writefile ('BMP',bmpbegin,BMPlength);
  986.           written(ID,bmplength);
  987.         End;
  988.       clearline;
  989.     end;
  990.   settime(h,min,s,hund);
  991. End;
  992.  
  993. Procedure writeFLIorC; {Extracts BMP files}
  994. Var flibegin,flilength: LongInt;
  995.  
  996. Begin
  997.   gettime(h,min,s,hund);
  998.   Position := (l - res) + X;
  999.   flilength := 0;
  1000.   fliBegin := Position - 5;
  1001.   h_seek (infile2, fliBegin,0);
  1002.   h_read(infile2,flilength,4);
  1003.   if (flilength > 0) and ((fliBegin + flilength) <= search.size) Then
  1004.     begin
  1005.       ID:='AutoDesk Animation';
  1006.       If SaveIt(ID,flibegin) then
  1007.         Begin
  1008.           writefile ('FLI',flibegin,flilength);
  1009.           written(ID,flilength);
  1010.         End;
  1011.       clearline;
  1012.     end;
  1013.    settime(h,min,s,hund);
  1014. End;
  1015.  
  1016. Procedure FoundWAVE; {Only detection of GIF}
  1017.  
  1018. var WaveLength,WaveBegin:longint;
  1019.     riff:array[1..4] of char;
  1020.  
  1021.  
  1022. Begin
  1023.   gettime(h,min,s,hund);
  1024.   clearline;
  1025.   Position := (l - res) + X;
  1026.   str(position-1,tempstring);
  1027.   if position >= 8 then begin
  1028.                          wavebegin:=position-9;
  1029.                          h_seek (infile2, wavebegin,0);
  1030.                          h_read(infile2,riff,4);
  1031.                          if riff='RIFF' then
  1032.                             begin
  1033.                             h_read(infile2,WaveLength,4);
  1034.                             WaveLength:=WaveLength+8;
  1035.                             if (wavelength > 0) and ((waveBegin + wavelength) <= search.size) Then
  1036.                             if abs(WaveLength)+abs(wavebegin) <= search.size then
  1037.                               begin
  1038.                                 ID:='Windows Wave file';
  1039.                                 If SaveIt(ID,WaveBegin) then
  1040.                                 Begin
  1041.                                   writefile ('WAV',WaveBegin,WaveLength);
  1042.                                   written(ID,WaveLength);
  1043.                                 End;
  1044.                                 clearline;
  1045.                               end
  1046.                             end;
  1047.                         end;
  1048.   settime(h,min,s,hund);
  1049. End;
  1050.  
  1051. Procedure FoundGIF; {Only detection of GIF}
  1052. Begin
  1053.   gettime(h,min,s,hund);
  1054.   clearline;
  1055.   Position := (l - res) + X;
  1056.   str(position-1,tempstring);
  1057.   writeit ('GIF Picture detected at position: '+tempstring+' bytes.',2,14,121);
  1058.   waitforkey;
  1059.   settime(h,min,s,hund);
  1060. End;
  1061.  
  1062. Procedure FoundJPG; {Only detection of JPG}
  1063. Begin
  1064.   gettime(h,min,s,hund);
  1065.   clearline;
  1066.   Position := (l - res) + X;
  1067.   str(position-1,tempstring);
  1068.   writeit ('JPG Picture detected at position: '+tempstring+' bytes.',2,14,121);
  1069.   waitforkey;
  1070.   settime(h,min,s,hund);
  1071. End;
  1072.  
  1073. Procedure writeCustom(custom:string); {Detected the Custom Header}
  1074. var CustomBegin,CustomLength,offset:longint;
  1075.     number:string;
  1076.     i:byte;
  1077. Begin
  1078.   gettime(h,min,s,hund);
  1079.   clearline;
  1080.   Position := (l - res) + X;
  1081.   CustomBegin:=position;
  1082.   number:=option[3];
  1083.   offset:=0;
  1084.   if number[1]='$' then begin {It's an HEX value...}
  1085.                            for i:=2 to (length(number)) do
  1086.                            case number[i] of {This formula converts a HEX string to a longint}
  1087.                            '0'..'9':offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(16)));
  1088.                            'A'..'F':offset:=offset+(ORD(number[i])-$37)*trunc(exp((length(number)-i)*ln(16)));
  1089.                            end;
  1090.                          end
  1091.                     else begin {It's decimal...}
  1092.                             for i:=1 to (length(number)) do {And this converts a DECIMAL string to a longint}
  1093.                             offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(10)));
  1094.                          end;
  1095.   CustomBegin:= position-offset;
  1096.   Customlength := search.size - position;
  1097.   custom[1]:='(';
  1098.   ID:='Custom '+custom+') File';
  1099.   if SaveIt(ID,position) then
  1100.        Begin
  1101.          writefile ('TMP',custombegin,customlength);
  1102.          written(ID,customlength);
  1103.        End;
  1104.   clearline;
  1105.   settime(h,min,s,hund);
  1106. End;
  1107.  
  1108. Procedure PartialCopy; {Copies a part from x to y out of a file}
  1109. var number1,number2:string;
  1110.     copybegin,copyend:longint;
  1111.     i:byte;
  1112. Begin
  1113.   number1:=option[2]; {begin}
  1114.   number2:=option[3]; {end}
  1115.   copybegin:=0;
  1116.   copyend:=0;
  1117.   upper(number1);
  1118.   upper(number2);
  1119.   if number1[2]='$' then begin {It's an HEX value...}
  1120.                            for i:=3 to (length(number1)) do
  1121.                            case number1[i] of {This formula converts a HEX string to a longint}
  1122.                            '0'..'9':copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(16)));
  1123.                            'A'..'F':copybegin:=copybegin+(ORD(number1[i])-$37)*trunc(exp((length(number1)-i)*ln(16)));
  1124.                            end;
  1125.                          end
  1126.                     else begin {It's decimal...}
  1127.                             for i:=2 to (length(number1)) do {And this converts a DECIMAL string to a longint}
  1128.                             copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(10)));
  1129.                          end;
  1130.   case number2[1] of
  1131.   '$': {It's an HEX value...}
  1132.        for i:=2 to (length(number2)) do
  1133.          case number2[i] of
  1134.          '0'..'9':copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(16)));
  1135.          'A'..'F':copyend:=copyend+(ORD(number2[i])-$37)*trunc(exp((length(number2)-i)*ln(16)));
  1136.          end;
  1137.   'E': if (number2[2]='N') and (number2[3]='D') then copyend:=search.size;
  1138.   else {It's decimal...}
  1139.        for i:=1 to (length(number2)) do
  1140.           copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(10)));
  1141.   end;
  1142.   str(copybegin,tempstring);
  1143.   writeit(' Begin: '+tempstring,1,16,121);
  1144.   str(copyend,tempstring);
  1145.   writeit('   End: '+tempstring,1,17,121);
  1146.   if copybegin>search.size then SmoothExit;
  1147.   if copybegin >= copyend then SmoothExit;
  1148.   writefile('$$$',copybegin,(copyend-copybegin));
  1149. end;
  1150.  
  1151. procedure SearchExtended;assembler;
  1152.  
  1153. asm
  1154.         mov cx,res
  1155.         mov di,-1
  1156. @search:cmp cx,0
  1157.         jz @nothing
  1158.         dec cx
  1159.         inc di
  1160.         mov ah,byte ptr sample[di]
  1161.         mov al,byte ptr sample[di+1]
  1162.         cmp ax,11AFh
  1163.         jb @search
  1164.         cmp ax,'if'
  1165.         ja @search
  1166. @FLI:   cmp ax,11AFh
  1167.         ja @FLC
  1168.         jb @search
  1169.         mov x,di
  1170.         inc x
  1171.         push di
  1172.         push cx
  1173.         call WriteFLIorC
  1174.         pop cx
  1175.         pop di
  1176.         jmp @search
  1177. @FLC:   cmp ax,12AFh
  1178.         ja @BMP
  1179.         jb @search
  1180.         mov x,di
  1181.         inc x
  1182.         push di
  1183.         push cx
  1184.         call WriteFLIorC
  1185.         pop cx
  1186.         pop di
  1187.         jmp @search
  1188. @BMP:   cmp ax,'BM'
  1189.         ja @E669
  1190.         jb @search
  1191.         mov x,di
  1192.         inc x
  1193.         push di
  1194.         push cx
  1195.         call WriteBMP
  1196.         pop cx
  1197.         pop di
  1198.         jmp @search
  1199. @E669:  cmp ax,'JN'
  1200.         ja @669
  1201.         jb @search
  1202.         mov x,di
  1203.         inc x
  1204.         push di
  1205.         push cx
  1206.         call Write669
  1207.         pop cx
  1208.         pop di
  1209.         jmp @search
  1210. @669:   cmp ax,'if'
  1211.         jnz @search
  1212.         mov x,di
  1213.         inc x
  1214.         push di
  1215.         push cx
  1216.         call Write669
  1217.         pop cx
  1218.         pop di
  1219.         jmp @search
  1220. @nothing:
  1221. end;
  1222.  
  1223. procedure SearchCustom;
  1224. var custom:string;
  1225.  
  1226. begin
  1227.   custom:=option[2];
  1228.   for X:=0 to res do
  1229.      begin
  1230.        found:=0;
  1231.        for y:=1 to (ord(custom[0])-1) do
  1232.                                       if sample[X+Y]=custom[Y+1] then inc(found);
  1233.        if found=ord(custom[0])-1 then writeCustom(custom);
  1234.      end;
  1235. end;
  1236.  
  1237. procedure SearchEngine;assembler;
  1238. asm
  1239.         mov cx,res
  1240.         mov di,-1
  1241. @search:cmp cx,0
  1242.         jz @nothing
  1243.         dec cx
  1244.         inc di
  1245.         mov ah,byte ptr sample[di]
  1246.         mov al,byte ptr sample[di+1]
  1247.         mov bh,byte ptr sample[di+2]
  1248.         mov bl,byte ptr sample[di+3]
  1249.         cmp ax,'01'
  1250.         jb @search
  1251.         cmp ax,'ea'
  1252.         ja @search
  1253.         cmp bx,'CG'
  1254.         jb @search
  1255.         cmp bx,'te'
  1256.         ja @search
  1257.  
  1258.         cmp ax,'32'
  1259.         ja @CHN
  1260.         cmp bx,'CH'
  1261.         jnz @CHN
  1262.         mov x,di
  1263.         inc x
  1264.         sub ah,030h         {Convert chars in AX to normal word}
  1265.         sub al,030h
  1266.         mov dl,al
  1267.         mov al,ah
  1268.         xor ah,ah
  1269.         mov bl,10
  1270.         mul bl
  1271.         add al,dl
  1272.         shl ax,8
  1273.         mov patternsize,ax
  1274.         push di
  1275.         push cx
  1276.         call WriteMOD
  1277.         pop cx
  1278.         pop di
  1279.         jmp @search
  1280. @CHN:   cmp ah,'1'
  1281.         jb @search
  1282.         cmp ah,'9'
  1283.         ja @BMOD
  1284.         cmp al,'C'
  1285.         jnz @BMOD
  1286.         cmp bx,'HN'
  1287.         jnz @search
  1288.         mov x,di
  1289.         inc x
  1290.         shr ax,8
  1291.         sub al,030h
  1292.         shl ax,8
  1293.         mov patternsize,ax
  1294.         push di
  1295.         push cx
  1296.         call WriteMOD
  1297.         pop cx
  1298.         pop di
  1299.         jmp @search
  1300. @BMOD:  cmp ax,'2S'
  1301.         ja @AMF
  1302.         cmp bx,'TM'
  1303.         jnz @search
  1304.         mov x,di
  1305.         inc x
  1306.         push di
  1307.         push cx
  1308.         call WriteSTM
  1309.         pop cx
  1310.         pop di
  1311.         jmp @search
  1312. @AMF:   cmp ax,'AM'
  1313.         ja @DMF
  1314.         jb @search
  1315.         cmp bh,'F'
  1316.         jnz @search
  1317.         mov x,di
  1318.         inc x
  1319.         push di
  1320.         push cx
  1321.         call WriteAMF
  1322.         pop cx
  1323.         pop di
  1324.         jmp @search
  1325. @DMF:   cmp ax,'DD'
  1326.         ja @MDL
  1327.         jb @search
  1328.         cmp bx,'MF'
  1329.         jnz @search
  1330.         mov x,di
  1331.         inc x
  1332.         push di
  1333.         push cx
  1334.         call WriteDMF
  1335.         pop cx
  1336.         pop di
  1337.         jmp @search
  1338. @MDL:   cmp ax,'DM'
  1339.         ja @XM
  1340.         jb @search
  1341.         cmp bx,'DL'
  1342.         jnz @search
  1343.         mov x,di
  1344.         inc x
  1345.         push di
  1346.         push cx
  1347.         call WriteMDL
  1348.         pop cx
  1349.          pop di
  1350.         jmp @search
  1351. @XM:    cmp ax,'Ex'
  1352.         ja @FAR
  1353.         jb @search
  1354.         cmp bx,'te'
  1355.         jnz @search
  1356.         mov x,di
  1357.         inc x
  1358.         push di
  1359.         push cx
  1360.         call WriteXM
  1361.         pop cx
  1362.         pop di
  1363.         jmp @search
  1364. @FAR:   cmp ax,'FA'
  1365.         ja @FLT4
  1366.         jb @search
  1367.         cmp bx,'R■'
  1368.         jnz @search
  1369.         mov x,di
  1370.         inc x
  1371.         push di
  1372.         push cx
  1373.         call WriteFAR
  1374.         pop cx
  1375.         pop di
  1376.         jmp @search
  1377. @FLT4:  cmp ax,'FL'
  1378.         ja @LBM
  1379.         jb @search
  1380.         cmp bx,'T4'
  1381.         jnz @FLT8
  1382.         mov patternsize,1024
  1383.         mov x,di
  1384.         inc x
  1385.         push di
  1386.         push cx
  1387.         call WriteMOD
  1388.         pop cx
  1389.         pop di
  1390.         jmp @search
  1391. @FLT8:  cmp bx,'T8'
  1392.         jnz @search
  1393.         mov patternsize,2048
  1394.         mov x,di
  1395.         inc x
  1396.         push di
  1397.         push cx
  1398.         call WriteMOD
  1399.         pop cx
  1400.         pop di
  1401.         jmp @search
  1402. @LBM:   cmp ax,'FO'
  1403.         ja @GIF
  1404.         jb @search
  1405.         cmp bx,'RM'
  1406.         jnz @search
  1407.         mov x,di
  1408.         inc x
  1409.         push di
  1410.         push cx
  1411.         call WriteLBM
  1412.         pop cx
  1413.         pop di
  1414.         jmp @search
  1415. @GIF:   cmp ax,'GI'
  1416.         ja @JPG
  1417.         jb @search
  1418.         cmp bx,'F8'
  1419.         jnz @search
  1420.         mov x,di
  1421.         inc x
  1422.         push di
  1423.         push cx
  1424.         call FoundGIF
  1425.         pop cx
  1426.         pop di
  1427.         jmp @search
  1428. @JPG:   cmp ax,'JF'
  1429.         ja @MK2
  1430.         jb @search
  1431.         cmp bx,'IF'
  1432.         jnz @search
  1433.         mov x,di
  1434.         inc x
  1435.         push di
  1436.         push cx
  1437.         call FoundJPG
  1438.         pop cx
  1439.         pop di
  1440.         jmp @search
  1441. @MK2:   cmp ax,'M!'
  1442.         ja @MK1
  1443.         jb @search
  1444.         cmp bx,'K!'
  1445.         jnz @search
  1446.         mov patternsize,1024
  1447.         mov x,di
  1448.         inc x
  1449.         push di
  1450.         push cx
  1451.         call WriteMOD
  1452.         pop cx
  1453.         pop di
  1454.         jmp @search
  1455. @MK1:   cmp ax,'M.'
  1456.         ja @ULT
  1457.         jb @search
  1458.         cmp bx,'K.'
  1459.         jnz @search
  1460.         mov patternsize,1024
  1461.         mov x,di
  1462.         inc x
  1463.         push di
  1464.         push cx
  1465.         call WriteMOD
  1466.         pop cx
  1467.         pop di
  1468.         jmp @search
  1469. @ULT:   cmp ax,'MA'
  1470.         ja @MTM
  1471.         jb @search
  1472.         cmp bx,'S_'
  1473.         jnz @search
  1474.         mov x,di
  1475.         inc x
  1476.         push di
  1477.         push cx
  1478.         call WriteULT
  1479.         pop cx
  1480.         pop di
  1481.         jmp @search
  1482. @MTM:   cmp ax,'MT'
  1483.         ja @OCTA
  1484.         jb @search
  1485.         cmp bh,'M'
  1486.         jnz @MIDI
  1487.         mov x,di
  1488.         inc x
  1489.         push di
  1490.         push cx
  1491.         call WriteMTM
  1492.         pop cx
  1493.         pop di
  1494.         jmp @search
  1495. @MIDI:  cmp bx,'hd'
  1496.         jnz @search
  1497.         mov x,di
  1498.         inc x
  1499.         push di
  1500.         push cx
  1501.         call WriteMIDI
  1502.         pop cx
  1503.         pop di
  1504.         jmp @search
  1505. @OCTA:  cmp ax,'OC'
  1506.         ja @PAC
  1507.         jb @search
  1508.         cmp bx,'TA'
  1509.         jnz @search
  1510.         mov patternsize,2048
  1511.         mov x,di
  1512.         inc x
  1513.         push di
  1514.         push cx
  1515.         call WriteMOD
  1516.         pop cx
  1517.         pop di
  1518.         jmp @search
  1519. @PAC:   cmp ax,'PA'
  1520.         ja @PTM
  1521.         jb @search
  1522.         cmp bx,'CG'
  1523.         jnz @search
  1524.         mov x,di
  1525.         inc x
  1526.         push di
  1527.         push cx
  1528.         call WritePAC
  1529.         pop cx
  1530.         pop di
  1531.         jmp @search
  1532. @PTM:   cmp ax,'PT'
  1533.         ja @S3M
  1534.         jb @search
  1535.         cmp bx,'MF'
  1536.         jnz @search
  1537.         mov x,di
  1538.         inc x
  1539.         push di
  1540.         push cx
  1541.         call WritePTM
  1542.         pop cx
  1543.         pop di
  1544.         jmp @search
  1545. @S3M:   cmp ax,'SC'
  1546.         ja @WAV
  1547.         jb @search
  1548.         cmp bx,'RM'
  1549.         jnz @search
  1550.         mov x,di
  1551.         inc x
  1552.         push di
  1553.         push cx
  1554.         call WriteS3M
  1555.         pop cx
  1556.         pop di
  1557.         jmp @search
  1558. @WAV:   cmp ax,'WA'
  1559.         ja @STM2
  1560.         jb @search
  1561.         cmp bx,'VE'
  1562.         jnz @search
  1563.         mov x,di
  1564.         inc x
  1565.         push di
  1566.         push cx
  1567.         call FoundWAVE
  1568.         pop cx
  1569.         pop di
  1570.         jmp @search
  1571. @STM2:  cmp ax,'eP'
  1572.         ja @STM
  1573.         jb @search
  1574.         cmp bx,'ro'
  1575.         jnz @search
  1576.         mov x,di
  1577.         inc x
  1578.         push di
  1579.         push cx
  1580.         call WriteSTM
  1581.         pop cx
  1582.         pop di
  1583.         jmp @search
  1584. @STM:   cmp ax,'ea'
  1585.         jnz @search
  1586.         cmp bx,'m!'
  1587.         jnz @search
  1588.         mov x,di
  1589.         inc x
  1590.         push di
  1591.         push cx
  1592.         call WriteSTM
  1593.         pop cx
  1594.         pop di
  1595.         jmp @search
  1596. @nothing:
  1597. end;
  1598.  
  1599. Begin {Main Program}
  1600.   if IsVga then
  1601.     begin
  1602.       total:=0;
  1603.       asm push cs end; {Well...this seems to be a HUGE error in TP}
  1604.       SetFont;
  1605.       CursorOff;
  1606.       filenum:=0;
  1607.       GetMem(pFileName,80);
  1608.         begin
  1609.           GetTime(h,min_old,s_old,hund_old);
  1610.           If (GetArgCount = 0) Then begin
  1611.                                       DisplayHelp;
  1612.                                       if option[1] = #0 then SmoothExit;
  1613.                                     end
  1614.                                Else begin
  1615.                                       GetMem(pP,80); {Reserve some memory for commandline string}
  1616.                                       GetArgStr(pP,1,80);  {Filename, specified at commandline}
  1617.                                       option[1]:=Str2Pas(PP);
  1618.                                       GetArgStr(PP,2,80);  {Filename, specified at commandline}
  1619.                                       option[2]:=Str2Pas(PP);
  1620.                                       GetArgStr(PP,3,80);  {Filename, specified at commandline}
  1621.                                       option[3]:=Str2Pas(PP);
  1622.                                     end;
  1623.           for y:=2 to 25 do for x:=1 to 80 do writeit(' ',x,y,112); {Clearscreen, not fast, but easy}
  1624.           writeit (' Fast Module Extractor 2.0                                       ■TWC■ (c) 1995 ',1,1,79);
  1625.           writeit ('                  The easy way to extract music and graphics                    ',1,25,30);
  1626.           drawline(13,125);
  1627.           drawline (15,117);
  1628.           PP:=Pas2PChar(option[1]);
  1629.           doserror:=FindFirst (PP, 0, Search);
  1630.           FileSplit (PP, D, N, E);
  1631.           filename:=Str2Pas(D);
  1632.           filename:=filename+Search.Name;
  1633.           if option[2,1]='#' then
  1634.             begin
  1635.               writeit(' Working in partial copy mode',1,19,113);
  1636.               writeit(' Copying from: '+ search.name,1,21,113);
  1637.               Pfilename:=Pas2PChar(filename);
  1638.               infile2:=h_Openfile(PFilename,0);
  1639.               PartialCopy;
  1640.               h_closefile(infile2);
  1641.               waitforkey;
  1642.           end
  1643.           else
  1644.           if doserror=0 then
  1645.             begin
  1646.               While DosError = 0 Do
  1647.                 begin
  1648.                   upper(filename);
  1649.                   Pfilename:=Pas2PChar(filename);
  1650.                   infile1:=h_Openfile(PFilename,0);
  1651.                   Attr:=GetFileAttr(Pfilename);
  1652.                   if Attr and faReadOnly <> 0 then begin
  1653.                                                      Readonlyfile := True; {Remove read-only attr}
  1654.                                                      SetFileAttr(pas2pchar(filename), faArchive);
  1655.                                                    end
  1656.                   else Readonlyfile := False;
  1657.                       infile2:=h_Openfile(PFilename,0);
  1658.                       l := 0;
  1659.                       position := 0;
  1660.                       writeit('Filename: '+str2pas(pfilename)+'                     ',34,5,127);
  1661.                       writeit(' Starting time: '+leadingzero(h)+':'+leadingzero(min_old)+':'+leadingzero(s_old),1,20,127);
  1662.                       for Y := 1 to 25 do writeit ('▒',1+Y,5,112);
  1663.                       res:=0;
  1664.                       if search.size > 0 then
  1665.                         repeat
  1666.                           res:=h_read (infile1, sample, SizeOf (sample));
  1667.                           l:=l+res;
  1668.                           str(l:7,tempstring);
  1669.                           writeit ('Processing: '+tempstring,2,3,121);
  1670.                           str(search.size:7,tempstring);
  1671.                           writeit (' bytes of '+tempstring+' bytes.      ',21,3,121);
  1672.                           str(total,tempstring);
  1673.                           writeit (' Total scanned: '+tempstring+' bytes',1,22,127);
  1674.                           drawbar(l * 100 Div search.size,5);
  1675.                           case option[2,1] of
  1676.                           'X','x': begin
  1677.                                      writeit ('┤Extended mode├',65,15,117);
  1678.                                      SearchExtended;
  1679.                                    end;
  1680.                           '!':     begin
  1681.                                      writeit ('┤Custom mode├',67,15,117);
  1682.                                      SearchCustom;
  1683.                                    end;
  1684.                           end;
  1685. {----------------------------------------------------------------------------}
  1686.                           SearchEngine; {The central search-engine!}
  1687. {----------------------------------------------------------------------------}
  1688.                           Total:=Total+res;
  1689.                           if port[$60]=1 then SmoothExit; {Quick-escape...}
  1690.                         until res < buffer;
  1691.                       if readonlyfile Then Attr:=SetFileAttr(pas2pchar(filename), faReadonly+faArchive);
  1692.                       h_CloseFile(infile1);
  1693.                       h_CloseFile(infile2);
  1694.                       doserror:=FindNext(search);
  1695.                       filename:=Str2Pas(D);
  1696.                       filename:=filename+Search.Name;
  1697.                 end;
  1698.               gettime(h,min,s,hund);
  1699.               writeit('Ending time: '+leadingzero(h)+':'+leadingzero(min)+':'+leadingzero(s),4,21,127);
  1700.               thetime:=((hund/100) + (min / 60) + s) - ((hund_old/100) + (min_old / 60) + s_old);
  1701.               str(thetime:2:2,tempstring);
  1702.               writeit(' Total scanning time: '+tempstring+' seconds',1,23,122);
  1703.               str(((Total / 1024) / thetime):2:2,tempstring);
  1704.               writeit('      Speed:  '+tempstring+' kb/s',40,23,122);
  1705.               writeit('Scan completed',2,14,121);
  1706.               waitforkey;
  1707.             end
  1708.           else
  1709.             begin
  1710.               writeit(' File not found',2,14,121);
  1711.               readkey;
  1712.             end;
  1713.         end
  1714.     end
  1715.   else writeit('This program requires VGA',1,1,7);
  1716.   SmoothExit;
  1717. End.
  1718.